home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / utility / sccan.zip / UNIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-07-10  |  10KB  |  337 lines

  1. unit Unit1;
  2.  
  3. {  SCAN - Table Scanning Utility 1.1 - Main Unit
  4.    Copyright (c) 1996 by Martin Kelly, PDQ Technology Limited
  5.    All rights reserved.
  6.  
  7.    This software should not be SOLD by anyone other than the author,
  8.    Martin Kelly. It is distributed as freeware and therefore may be used
  9.    free of charge.
  10.  
  11.    Comments:
  12.    Compuserve ID: 100437,2243
  13.  
  14.    Payback:
  15.    I have been downloading lots of interesting stuff from the Delphi forums
  16.    for months, so I thought it was about time I uploaded something (useful?)
  17.    on the basis that giving is apparently more spiritually rewarding than
  18.    taking.
  19.  
  20.    Disclaimer:
  21.    The author shall have no liability whatsoever in respect of the use of
  22.    this program, and nor does the author warrant that the use of this program
  23.    will be uninterrupted or error free. }
  24.  
  25. interface
  26.  
  27. uses
  28.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  29.   Forms, Dialogs, StdCtrls, DB, Grids, DBGrids, DBTables, ExtCtrls, Buttons,
  30.   DBCtrls, Menus, Unit2, Unit3;
  31.  
  32. type
  33.   TMain = class(TForm)
  34.     Table1: TTable;
  35.     Table2: TTable;
  36.     DBGrid1: TDBGrid;
  37.     DBGrid2: TDBGrid;
  38.     DataSource1: TDataSource;
  39.     DataSource2: TDataSource;
  40.     Panel1: TPanel;
  41.     Panel2: TPanel;
  42.     Panel3: TPanel;
  43.     BitBtn1: TBitBtn;
  44.     SpeedButton1: TSpeedButton;
  45.     SpeedButton2: TSpeedButton;
  46.     Label1: TLabel;
  47.     Label2: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     DBNavigator1: TDBNavigator;
  50.     OpenDialog2: TOpenDialog;
  51.     BitBtn2: TBitBtn;
  52.     MainMenu1: TMainMenu;
  53.     File1: TMenuItem;
  54.     Exit1: TMenuItem;
  55.     Help1: TMenuItem;
  56.     Contents: TMenuItem;
  57.     SpeedHelp: TSpeedButton;
  58.     SpeedClose: TSpeedButton;
  59.     SelectMastertable1: TMenuItem;
  60.     SelecttabletoComparewithMaster1: TMenuItem;
  61.     N1: TMenuItem;
  62.     Cleartableselections1: TMenuItem;
  63.     N2: TMenuItem;
  64.     N3: TMenuItem;
  65.     Comparethetables1: TMenuItem;
  66.     N4: TMenuItem;
  67.     About1: TMenuItem;
  68.     procedure BitBtn1Click(Sender: TObject);
  69.     procedure SpeedButton1Click(Sender: TObject);
  70.     procedure SpeedButton2Click(Sender: TObject);
  71.     procedure DBGrid1Enter(Sender: TObject);
  72.     procedure DBGrid2Enter(Sender: TObject);
  73.     procedure BitBtn2Click(Sender: TObject);
  74.     procedure SpeedCloseClick(Sender: TObject);
  75.     procedure SpeedHelpClick(Sender: TObject);
  76.     procedure About1Click(Sender: TObject);
  77.   private
  78.     { Private declarations }
  79.   public
  80.     { Public declarations }
  81.   end;
  82.  
  83. var
  84.   Main: TMain;
  85.  
  86. implementation
  87.  
  88. {$R *.DFM}
  89.  
  90. procedure TMain.BitBtn1Click(Sender: TObject);
  91. var
  92. F: TextFile;
  93. S, Table1PrimIndxStr, Table2PrimIndxStr: String;
  94. I: Integer;
  95.  
  96. BEGIN
  97. {Check that both datasets are active}
  98.  if not Table1.Active or not Table2.Active then
  99.  begin
  100.   MessageDlg('Table selections are incomplete.', mtError, [mbOk], 0);
  101.   Abort;
  102.  end;
  103.  
  104. {Check that the tables have the same number of fields}
  105.  if IntToStr(DBGrid1.FieldCount)<>IntToStr(DBGrid2.FieldCount)then
  106.  begin
  107.   MessageDlg('Tables MUST have the same structure.', mtError, [mbOk], 0);
  108.   Abort;
  109.  end;
  110.  
  111. {Ensure that the most recent index information is used}
  112.  Table1.IndexDefs.Update;
  113.  Table2.IndexDefs.Update;
  114.  
  115. {Initialize String Variables}
  116.  Table1PrimIndxStr := '';
  117.  Table2PrimIndxStr := '';
  118.  
  119. {Try to locate primary index for both tables}
  120.   for I := 0 to Table1.IndexDefs.Count - 1 do
  121.      {Find primary index}
  122.      if (ixPrimary in Table1.IndexDefs.Items[I].Options) then
  123.      {Save the field names of the key to String Variable}
  124.      Table1PrimIndxStr := Table1.IndexDefs.Items[I].Fields;
  125.   for I := 0 to Table2.IndexDefs.Count - 1 do
  126.      {Find primary index}
  127.      if (ixPrimary in Table2.IndexDefs.Items[I].Options) then
  128.      {Save the fields names of the key to String Variable}
  129.      Table2PrimIndxStr := Table2.IndexDefs.Items[I].Fields;
  130.  
  131. {Check for primary index in Table1}
  132.  if Table1PrimIndxStr = '' then
  133.     begin
  134.       MessageDlg(Table1.TableName + ' does not have a Primary Index.',
  135.                  mtError, [mbOk], 0);
  136.       Abort;
  137.     end;
  138.  
  139. {Check for primary index in Table2}
  140.  if Table2PrimIndxStr = '' then
  141.     begin
  142.       MessageDlg(Table2.TableName + ' does not have a Primary Index.',
  143.                  mtError, [mbOk], 0);
  144.       Abort;
  145.     end;
  146.  
  147. {Compare primary index fields found in both tables}
  148.  if Table1PrimIndxStr <> Table2PrimIndxStr then
  149.     begin
  150.      MessageDlg('Primary Index fields in tables do not match.',
  151.                  mtError, [mbOk], 0);
  152.      Abort;
  153.     end;
  154.  
  155. {Prepare the text file}
  156.  AssignFile(F, 'SCANLOG.TXT');
  157.  Rewrite(F);
  158.  Writeln(F, DateTimeToStr(Now));
  159.  Writeln(F, '');
  160.  Writeln(F, 'Master table: '+ OpenDialog1.FileName);
  161.  
  162. {Initialize String Variable}
  163.  S := '';
  164.  
  165. {Use TRY..EXCEPT to trap exceptions..}
  166.  TRY
  167.  with Table1 do
  168.  {Create a composite string with the key field names separated by ', '}
  169.     for I := 0 to IndexFieldCount - 1 do
  170.     S := S + ', ' + IndexFields[I].FieldName;
  171.  
  172. {Remove initial ', '}
  173.  Delete(S,1,2);
  174.  Writeln(F, 'Primary index: ' + S);
  175.  Writeln (F,'');
  176.  Writeln(F, 'Differences identified in '+ OpenDialog2.FileName);
  177.  Writeln (F,'');
  178.  {Goto first record in Table1}
  179.  Table1.First;
  180.   While not Table1.EOF do
  181.    begin
  182.      S := '';
  183.      {Put Table2 in SetKey state}
  184.      {Note - as no value has been assigned to the IndexName property then
  185.              Primary Index is utilised. Delphi always open tables on its
  186.              Primary Index.}
  187.      Table2.SetKey;
  188.      with Table1 do
  189.      {Assign Values to be searched for in Table2 using Primary Key}
  190.      for I := 0 to IndexFieldCount - 1 do
  191.      Table2.Fields[I].AsString := IndexFields[I].AsString;
  192.      with Table1 do
  193.      {Create a composite string with the key field values separated by ', '}
  194.       for I := 0 to IndexFieldCount - 1 do
  195.       S := S + ', ' + IndexFields[I].AsString;
  196.      {Remove initial ', '}
  197.       Delete(S,1,2);
  198.       if Table2.GotoKey then
  199.      {Check field values in all fields}
  200.       for I := 0 to Table1.FieldCount - 1 do
  201.       begin
  202.       if Table1.Fields[I].AsString <>
  203.          Table2.Fields[I].AsString then
  204.          Writeln(F, S + ': '+ Table2.Fields[I].FieldName + ' = '
  205.          + (Table2.Fields[I].AsString));
  206.       end
  207.     else
  208.     {Record must have been deleted from Table2}
  209.      Writeln(F, S + ' is NOT found in '+ OpenDialog2.FileName);
  210.  
  211.      Table1.Next;
  212.    end;
  213.  
  214.  {Checking for new records added to Table2}
  215.  {Goto first record in Table2}
  216.  Table2.First;
  217.  While not Table2.EOF do
  218.  begin
  219.    {Put Table1 in SetKey state}
  220.    {Note - as no value has been assigned to the IndexName property then
  221.            Primary Index is utilised. Delphi always open tables on its
  222.            Primary Index.}
  223.     Table1.SetKey;
  224.      with Table2 do
  225.       {Assign Values to be searched for in Table1 using Primary Key}
  226.       for I := 0 to IndexFieldCount - 1 do
  227.       Table1.Fields[I].AsString := IndexFields[I].AsString;
  228.      if not Table1.GotoKey then
  229.      begin
  230.      Writeln (F,'');
  231.      Writeln(F, 'New record found in '+ OpenDialog2.FileName
  232.              +' with these values:');
  233.        for I := 0 to Table2.FieldCount - 1 do
  234.            Writeln(F, Table2.Fields[I].FieldName + ' = '
  235.            + (Table2.Fields[I].AsString));
  236.      end;
  237.    Table2.Next;
  238.    end;
  239.  {Tidy up}
  240.  CloseFile(F);
  241.  Table1.First;
  242.  Table2.First;
  243.  
  244.  {Open Scanlog.txt using NOTEPAD.EXE}
  245.  WinExec('NOTEPAD.EXE Scanlog.txt',SW_SHOWNORMAL);
  246.  
  247.  EXCEPT
  248.   on EDatabaseError do
  249.    begin
  250.     MessageDlg('Problem detected when examining data tables.',
  251.               mtError, [mbOk], 0);
  252.     {Tidy up}
  253.     CloseFile(F);
  254.     Table1.First;
  255.     Table2.First;
  256.    end;
  257.   on EDBEngineError do
  258.    begin
  259.     MessageDlg('Problem detected when examining data tables.',
  260.               mtError, [mbOk], 0);
  261.     {Tidy up}
  262.     CloseFile(F);
  263.     Table1.First;
  264.     Table2.First;
  265.    end;
  266.  END;
  267. END;
  268.  
  269. procedure TMain.SpeedButton1Click(Sender: TObject);
  270. begin
  271.  if OpenDialog1.Execute then
  272.  begin
  273.  Table1.Active := False;  {Ensure existing selection is deactivated}
  274.  Label1.Caption := OpenDialog1.FileName;
  275.  Table1.TableName := OpenDialog1.FileName;
  276.  Table1.Active := True;
  277.  end;
  278. end;
  279.  
  280. procedure TMain.SpeedButton2Click(Sender: TObject);
  281. begin
  282. if OpenDialog2.Execute then
  283.  begin
  284.  Table2.Active := False;  {Ensure existing selection is deactivated}
  285.  Label2.Caption := OpenDialog2.FileName;
  286.  Table2.TableName := OpenDialog2.FileName;
  287.  Table2.Active := True;
  288.  end;
  289. end;
  290.  
  291. procedure TMain.DBGrid1Enter(Sender: TObject);
  292. begin
  293.  {Assign DBNavigator to DataSource looking at Table1}
  294.  DBNavigator1.DataSource := DataSource1;
  295. end;
  296.  
  297. procedure TMain.DBGrid2Enter(Sender: TObject);
  298. begin
  299.  {Assign DBNavigator to DataSource looking at Table2}
  300.  DBNavigator1.DataSource := DataSource2;
  301. end;
  302.  
  303. procedure TMain.BitBtn2Click(Sender: TObject);
  304. begin
  305.  {Disable datasets}
  306.  Table1.Active := False;
  307.  Table2.Active := False;
  308.  {Change captions}
  309.  Label1.Caption := 'Select table';
  310.  Label2.Caption := 'Select table';
  311. end;
  312.  
  313. procedure TMain.SpeedCloseClick(Sender: TObject);
  314. begin
  315.  {Close program}
  316.  Close;
  317. end;
  318.  
  319. procedure TMain.SpeedHelpClick(Sender: TObject);
  320. begin
  321.  {Ensure that the TabbedNotebook is displaying the first tab}
  322.  ScanHelp.TabbedNotebook1.PageIndex := 0;
  323.  ScanHelp.ShowModal;
  324. end;
  325.  
  326. procedure TMain.About1Click(Sender: TObject);
  327. begin
  328.  {Show incredible AboutBox for massive EGO boost!}
  329.  AboutBox.ShowModal;
  330. end;
  331.  
  332. end.
  333.  
  334.  
  335.  
  336.  
  337.